home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0126_Sprite Game.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  12KB  |  361 lines
  1.  
  2. program SpriteGame;         {Verifies a VGA is present}
  3. {$G+,R-}
  4. (* jh  Syntax:  spritegame.exe  [number]
  5.   optional number is the total population of sprites.  Default is maxsprites.
  6. *)
  7. { Original Sprites program by Bas van Gaalen, Holland, PD }
  8. { Modified by Luis Mezquita Raya }
  9. { Modified by John Howard (jh) into a game }
  10. { 30-MAY-1994 jh Version 1.0
  11.   Now a game to see which sprite survives the longest.
  12.   Renamed tScrArray to Screen, and tSprArray to SpriteData.
  13.   Removed CRT unit & saved around 1616 bytes.  Added command line parameter.
  14.   Added timer and energy definitions to provide statistics.
  15.   21-JUN-1994 jh Version 1.1 = ~7.5k
  16.   Added OnlyVGA and SetMode procedures.  Added CharSet & CharType definitions.
  17.   Implemented characters as sprites.
  18.   29-JUN-1994 jh Version 1.2 = ~8.5k due to command line help
  19.   Places identification on each sprite by using HexDigits.  CharColor defaults
  20.   to sprite number (0..maxsprites) as a color index in the palette.  Fixed bug
  21.   in moire background screen limits.
  22. }
  23. const
  24.       maxsprites=128;                   { Number of sprites is [1..128] }
  25.       pxsize=320;                       { screen x-size }
  26.       pysize=200;                       { screen y-size }
  27.       xsize=32;                         { sprite x-size }
  28.       ysize=32;                         { sprite y-size }
  29.       CharRows=8;                       { Characters are 8 rows high }
  30.       HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  31.  
  32. type
  33.       Screen=array[0..pysize-1, 0..pxsize-1] of byte;
  34.       pScreen=^Screen;
  35.       SpriteData=array[0..ysize-1, 0..xsize-1] of byte;
  36.       pSpriteData=^SpriteData;
  37.       SprRec=record
  38.               x,y : word;              {Absolute location of sprite}
  39.               xspd,yspd : shortint;    {Velocity horizontal and vertical}
  40.               energy : shortint;       {Hide is neg., dead is 0, show is pos.}
  41.               buf : pSpriteData;       {Rectangle of sprite definition}
  42.              end;
  43.       CharType = array[1..CharRows] of Byte;
  44.  
  45. var
  46.       CharSet : array[0..255] of CharType absolute $F000:$FA6E;
  47.       sprite : array[1..maxsprites] of SprRec;
  48.       vidscr,virscr,bgscr : pScreen;   {video, virtual, background screens}
  49.       dead : byte;                     {Counts the dead sprites}
  50.       survivor : byte;                 {Identify the last dead sprite}
  51.       Population : word;               {Population from 1..128}
  52.       {CharColor : byte;}              {Character digit color 0..255}
  53.  
  54.       Timer : longint;                 {Stopwatch}
  55.       H, M, S, S100 : Word;
  56.       Startclock, Stopclock : Real;
  57.       mins, secs     : integer;
  58.       Code: integer;                     {temporary result of VAL conversion}
  59.  
  60. procedure GetTime(var Hr, Mn, Sec, S100 : word); assembler; {Avoids DOS unit}
  61. asm
  62.     mov ah,2ch
  63.     int 21h
  64.     xor ah,ah                 {fast register clearing instead of MOV AH,0}
  65.     mov al,dl
  66.     les di,S100
  67.     stosw
  68.     mov al,dh
  69.     les di,Sec
  70.     stosw
  71.     mov al,cl
  72.     les di,Mn
  73.     stosw
  74.     mov al,ch
  75.     les di,Hr
  76.     stosw
  77. end;
  78.  
  79. procedure StartTimer;
  80. begin
  81.   GetTime(H, M, S, S100);
  82.   StartClock := (H * 3600) + (M * 60) + S + (S100 / 100);
  83. end;
  84.  
  85. procedure StopTimer;
  86. begin
  87.   GetTime(H, M, S, S100);
  88.   StopClock := (H * 3600) + (M * 60) + S + (S100 / 100);
  89.   Timer := trunc(StopClock - StartClock);
  90.   secs := Timer mod 60;                             {Seconds remaining}
  91.   mins := Timer div 60;                             {Reduce into minutes}
  92. end;
  93. function KeyPressed : boolean; assembler;   {Avoids unit CRT.KeyPressed}
  94. asm
  95.     mov ah,01h;    int 16h;    jnz @0;    xor ax,ax;    jmp @1;
  96. @0: mov al,1
  97. @1:
  98. end;
  99.  
  100. procedure SetMode(M:byte); assembler;
  101. asm
  102.     mov ah,0;        mov al,M;        int 10h;
  103. end;
  104. procedure SetPal(col,r,g,b:byte); assembler;      {256 color palette}
  105. asm
  106.     mov dx,03c8h
  107.     mov al,col             {color}
  108.     out dx,al
  109.     inc dx
  110.     mov al,r               {red component}
  111.     out dx,al
  112.     mov al,g               {green component}
  113.     out dx,al
  114.     mov al,b               {blue component}
  115.     out dx,al
  116. end;
  117. procedure flip(srcscr, destscr : pScreen); assembler;   {copy screen}
  118. asm
  119.     push ds
  120.     lds si,srcscr
  121.     les di,destscr
  122.     mov cx,pxsize*pysize/2
  123.     rep movsw
  124.     pop ds
  125. end;
  126. procedure cls(scr : pScreen); assembler;   {clear screen}
  127. asm
  128.     les di,scr;  xor ax,ax;  mov cx,pxsize*pysize/2;  rep stosw
  129. end;
  130. procedure retrace; assembler;
  131. asm
  132.         mov dx,03dah
  133. @vert1: in al,dx
  134.         test al,8
  135.         jnz @vert1
  136. @vert2: in al,dx
  137.         test al,8
  138.         jz @vert2
  139. end;
  140. procedure PutSprite(var sprite: SprRec; virseg: pScreen); assembler;
  141. asm
  142.         push ds
  143.         lds si,sprite                   { get sprite segment }
  144.         les di,virseg                   { get virtual screen segment }
  145.         mov ax,SprRec[ds:si].y
  146.         shl ax,6
  147.         mov di,ax
  148.         shl ax,2
  149.         add di,ax                       { y*pxsize }
  150.         add di,SprRec[ds:si].x          { y*pxsize+x }
  151.         mov dx,pxsize-xsize             { number of pixels left on line }
  152.         lds si,SprRec[ds:si].buf
  153.         mov bx,ysize
  154. @l1:    mov cx,xsize
  155. @l0:    lodsb
  156.         or al,al
  157.         jz @skip                        { check if transparent "Black" }
  158.         mov es:[di],al                  { draw it }
  159. @skip:  inc di
  160.         dec cx
  161.         jnz @l0
  162.         add di,dx
  163.         dec bx
  164.         jnz @l1
  165.         pop ds
  166. end;
  167. procedure OnlyVGA; assembler;
  168. asm
  169.   @CheckForVga: {push    es}
  170.                 mov     AH,1ah         {Get Display Combination Code}
  171.                 mov     AL,00h         {AX := $1A00;}
  172.                 int     10h            {Intr($10, Regs);}
  173.                 cmp     AL,1ah         {IsVGA:= (AL=$1A) AND((BL=7) OR(BL=8))}
  174.                 jne     @NoVGA
  175.                 cmp     BL,07h         {VGA w/ monochrome analog display}
  176.                 je      @VgaPresent
  177.                 cmp     BL,08h         {VGA w/ color analog display}
  178.                 je      @VgaPresent
  179.   @NoVGA:
  180.                 mov     ax,3           {text mode}
  181.                 int     10h
  182.                 push    cs
  183.                 pop     ds
  184.                 lea     dx,@message
  185.                 mov     ah,9
  186.                 int     21h            {print $ terminated string}
  187.                 mov     ax,4c00h
  188.                 int     21h            {terminate}
  189.   @message:     db      'Sorry, but you need a VGA to see this!',10,13,24h
  190.   @VgaPresent:  {pop     es}
  191.   {... After here is where your VGA code can execute}
  192. end;  {OnlyVGA}
  193.  
  194. VAR   n : byte;               {sprite number}
  195.       hx,hy,i,j,k,np : integer;
  196. BEGIN  {PROGRAM}
  197.  {Get text from command line and convert into a number}
  198.  Val(ParamStr(1), Population, Code);
  199.  if (Code <> 0)    {writeln('Bad number at position: ', Code);}
  200.    OR (Population <1) OR (Population > maxsprites) then
  201.    Population := maxsprites;    {default}
  202.  if ParamStr(1) = '?' then
  203.    begin
  204.     writeln('Howard International, P.O. Box 34633, NKC, MO 64116 USA');
  205.     writeln('1994 Freeware Sprite Game v1.2');
  206.     writeln('Syntax:  spritegame.exe  [number]');
  207.     writeln('         optional number is the total population of sprites (1 to 128)');
  208.     halt;
  209.    end;
  210.  
  211.  {CharColor := Population;}
  212.  OnlyVGA;
  213.  SetMode($13);                  {320x200x256x1 plane}
  214.  Randomize;
  215.  vidscr := Ptr($A000,0);
  216.  New(virscr); cls(virscr); New(bgscr); cls(bgscr);
  217.  np := 128 div Population;
  218.  for i := 0 to Population-1 do
  219.   begin  {Define moire background pattern}
  220.    case i mod 6 of
  221.     0:begin
  222.        hx := 23;       hy := i*np;       n := 0;
  223.       end;
  224.     1:begin
  225.        hx := i*np;     hy := 23;         n := 0;
  226.       end;
  227.     2:begin
  228.        hx := i*np;     hy := 0;          n := 23;
  229.       end;
  230.     3:begin
  231.        hx := 23;       hy := 0;          n := i*np;
  232.       end;
  233.     4:begin
  234.        hx := 0;        hy := 23;         n := i*np;
  235.       end;
  236.     5:begin
  237.        hx:= 0;         hy:= i*np;        n := 23;
  238.       end;
  239.    end;
  240.    for j := 0 to np-1 do
  241.     begin
  242.      k := j shr 1;
  243.      SetPal(np*i+j+1, k+hx, k+hy, k+n);
  244.     end;
  245.   end;
  246.  
  247.  for i := 1 to 127 do SetPal(127+i, i div 3, 20+i div 5, 20+i div 7);
  248.  for i := 0 to pxsize-1 do     {jh bug!  Reduce to legal screen limits}
  249.    for j := 0 to pysize-1 do
  250.      bgscr^[j,i] := 128+ ABS(i*i - j*j) and 127;
  251. (*
  252.  flip(bgscr, vidscr);               {copy background to video}
  253.  {SetPal(?,r,g,b)}                  {force a visible text palette entry}
  254.  writeln('Sprite Game v1.2 ');      {modify video}
  255.  flip(vidscr, bgscr);               {copy video to background}
  256. *)
  257.  hx := xsize shr 1;
  258.  hy := ysize shr 1;
  259.  for n := 1 to Population do
  260.   begin
  261.    with sprite[n] do
  262.     begin
  263.      x := 20+ random(280 - xsize);
  264.      y := 20+ random(160 - ysize);
  265.      xspd := random(6) - 3;
  266.      yspd := random(6) - 3;
  267.      energy := random(10);         {punishes liberals}
  268.      if xspd=0 then
  269.        begin
  270.         xspd := 1;
  271.         energy := random(20);      {average life expectancy}
  272.        end;
  273.      if yspd=0 then
  274.        begin
  275.         yspd := 1;
  276.         energy := random(40);      {rewards conservatives}
  277.        end;
  278.      New(buf);
  279.      for i := 0 to xsize-1 do
  280.       for j := 0 to ysize-1 do
  281.        begin
  282.         k := (i-hx) * (i-hx) + (j-hy) * (j-hy);
  283.         if (k< hx*hx) and (k> hx*hx div 16)
  284.         then buf^[j,i] := k mod np  + np * (n-1)
  285.         else buf^[j,i] := 0;       {CRT color "Black" is transparent}
  286.        end;
  287.     end; {with}
  288.   end; {for}
  289.  
  290.   {jh Can store your own bitmap image in any sprite[n].buf^[j,i] such as: }
  291.   for i := 0 to xsize-1 do
  292.     for j := 0 to ysize-1 do
  293.       begin
  294.         sprite[1].buf^[j,i] := j;           {first sprite.  Horizontal bars}
  295.         sprite[Population].buf^[j,i] := i;  {last sprite.  Vertical bars}
  296.       end;
  297.  
  298.   {jh Get characters from default font and attach to sprites}
  299.   for i := 1 to CharRows do
  300.     for j := 1 to CharRows do
  301.       begin
  302.         for n := 1 to Population do
  303.           begin
  304.             {first hex digit for current sprite}
  305.             if (CharSet[ord(HexDigits[n SHR 4]),i] shr (8-j) and 1 = 1) then
  306.               sprite[n].buf^[i,j] := n       {CharColor}
  307.             else
  308.               sprite[n].buf^[i,j] := 0;      {transparent}
  309.             {second hex digit for current sprite}
  310.             if (CharSet[ord(HexDigits[n AND $F]),i] shr (8-j) and 1 =1) then
  311.               sprite[n].buf^[i,j+CharRows] := n   {CharColor}
  312.             else
  313.               sprite[n].buf^[i,j+CharRows] := 0;  {transparent}
  314.           end;
  315. (* {mark last sprite 'Z'}
  316.    sprite[Population].buf^[i,j] := CharSet[ord('Z'),i] shr (8-j) and 1; *)
  317.       end;
  318.  
  319.   {jh Keep track of the last dead sprite and how old it was. }
  320.   StartTimer;
  321.   while not (KeyPressed or (dead=Population)) do
  322.   begin
  323.   flip(bgscr, virscr);
  324.   retrace;
  325.   dead := 0;                         {reset the sentinel}
  326.   for n := 1 to Population do
  327.     with sprite[n] do
  328.     begin
  329.       if energy > 0 then PutSprite(sprite[n], virscr)     {show(n)}
  330.       { else if energy < 0 then hide(n) }
  331.       else inc(dead);
  332.       inc(x,xspd);
  333.       if (x<10) or (x > (310 - xsize)) then
  334.       begin
  335.         xspd := -xspd;
  336.         energy := energy - 1;
  337.       end;
  338.       inc(y,yspd);
  339.       if (y<10) or (y > (190 - ysize)) then
  340.       begin
  341.         yspd := -yspd;
  342.         energy := energy - 1;
  343.       end;
  344.     end; {with}
  345.   flip(virscr, vidscr);
  346.   end; {while}
  347.  
  348.   StopTimer;
  349.   survivor := 0;
  350.   for n := 1 to Population do
  351.     begin                           {find last dead sprite with zero energy}
  352.       if sprite[n].energy = 0 then survivor := n;
  353.       Dispose(sprite[n].buf);
  354.     end;
  355.   Dispose(virscr);  Dispose(bgscr);
  356.   SetMode($3);      {resume text video mode 3h= 80x25x16 color}
  357.   writeln('Last dead sprite was # ', survivor, ' of ', Population);
  358.   writeln('Time of death was ', trunc(StopClock));
  359.   writeln('Life span was ', mins:2, ' Minute and ', secs:2, ' Seconds');
  360. END.   {PROGRAM}
  361.